home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Skunkware 5
/
Skunkware 5.iso
/
src
/
X11
/
tclMotif-1.4
/
programs
/
xtmfm
< prev
next >
Wrap
Text File
|
1995-06-29
|
18KB
|
757 lines
#!/usrs/tm/src/moat -f
# An implementation of xmfm using tclMotif
set FILES_TOOLBAR_SIZE 6
#######################################################################
#
# This part creates the geometry of xtmfm, and sets up appropriate
# callbacks to handle behaviour
#
#######################################################################
#
# createApplication
# - toplevel create function for the whole lot
#
proc createApplication {} {
xmMainWindow .main
xmForm .main.form
xmLabel .main.form.dirLabel
set filesToolbar [createFilesToolbar .main.form]
set dirsToolbar [createDirsToolbar .main.form]
set pane [createPane .main.form]
set menu [createMenu .main]
panelSetFiles $pane
$menu manageChild
$dirsToolbar manageChild
$filesToolbar manageChild
$pane manageChild
.main.form.dirLabel manageChild
.main.form manageChild
.main manageChild
setGeometry .main.form.dirLabel $filesToolbar $dirsToolbar $pane
.main setValues -menuBar $menu -workWindow .main.form
}
#
# createFilesToolbar
#
proc createFilesToolbar {parent} {
global FILES_TOOLBAR_SIZE
global fileToolbarButtons
xmRowColumn $parent.filesToolbar managed \
-numColumns 3 \
-packing pack_column \
-orientation horizontal \
-adjustLast false
for {set n 0} {$n < $FILES_TOOLBAR_SIZE} {incr n} {
set button [xmPushButton $parent.filesToolbar.filesToolbarButton$n managed \
-labelString " "]
$button activateCallback "fileToolButtonPressed $n"
set fileToolbarButtons($n) $button
}
return $parent.filesToolbar
}
#
# createDirsToolbar
#
proc createDirsToolbar {parent} {
global FILES_TOOLBAR_SIZE
xmRowColumn $parent.dirsToolbar managed \
-numColumns 3 \
-packing pack_column \
-orientation horizontal \
-adjustLast false
for {set n 0} {$n < $FILES_TOOLBAR_SIZE} {incr n} {
set button [xmPushButton $parent.dirsToolbar.dirsToolbarButton$n managed \
-labelString " "]
$button activateCallback "fileToolButtonPressed $n"
}
return $parent.dirsToolbar
}
#
# createMenu
#
proc createMenu {parent} {
# top menu bar
xmMenuBar $parent.menuBar managed
xmCascadeButton $parent.menuBar.file managed \
-labelString File \
-mnemonic F
xmCascadeButton $parent.menuBar.edit managed \
-labelString Edit \
-mnemonic E
xmCascadeButton $parent.menuBar.help managed \
-labelString Help \
-mnemonic H
# file pulldown
xmPulldownMenu $parent.fileMenu
xmPushButton $parent.fileMenu.new managed \
-labelString "New..." \
-mnemonic N
xmPushButton $parent.fileMenu.quit managed \
-labelString Quit \
-mnemonic Q
$parent.fileMenu.quit activateCallback exit
$parent.menuBar.file setValues -subMenuId $parent.fileMenu
return $parent.menuBar
}
#
# createPane
#
proc createPane {parent} {
xmPanedWindow $parent.pane
# create the executable files section
xmForm $parent.pane.rc1 managed
xmLabel $parent.pane.rc1.executableFilter managed \
-topAttachment attach_form \
-leftAttachment attach_form
xmScrolledWindow $parent.pane.rc1.sw managed \
-scrollingPolicy automatic \
-topAttachment attach_widget \
-topWidget $parent.pane.rc1.executableFilter \
-leftAttachment attach_form \
-rightAttachment attach_form \
-bottomAttachment attach_form
xmRowColumn $parent.pane.rc1.sw.executablesPane managed
$parent.pane.rc1.sw setValues \
-workWindow $parent.pane.rc1.sw.executablesPane
# create the ordinary files section
xmForm $parent.pane.rc2 managed
xmLabel $parent.pane.rc2.fileFilter managed \
-topAttachment attach_form \
-leftAttachment attach_form
xmScrolledWindow $parent.pane.rc2.sw managed \
-scrollingPolicy automatic \
-topAttachment attach_widget \
-topWidget $parent.pane.rc2.fileFilter \
-leftAttachment attach_form \
-rightAttachment attach_form \
-bottomAttachment attach_form
xmRowColumn $parent.pane.rc2.sw.filesPane managed
$parent.pane.rc2.sw setValues \
-workWindow $parent.pane.rc2.sw.filesPane
# create the directories section
xmForm $parent.pane.rc3 managed
xmLabel $parent.pane.rc3.dirFilter managed \
-topAttachment attach_form \
-leftAttachment attach_form
xmScrolledWindow $parent.pane.rc3.sw managed \
-scrollingPolicy automatic \
-topAttachment attach_widget \
-topWidget $parent.pane.rc3.dirFilter \
-leftAttachment attach_form \
-rightAttachment attach_form \
-bottomAttachment attach_form
xmRowColumn $parent.pane.rc3.sw.dirsPane managed
$parent.pane.rc3.sw setValues \
-workWindow $parent.pane.rc3.sw.dirsPane
return $parent.pane
}
#
# setGeometry
#
proc setGeometry {dirLabel filesToolbar dirsToolbar pane} {
$dirLabel setValues \
-topAttachment attach_form \
-leftAttachment attach_form \
-rightAttachment attach_form
$filesToolbar setValues \
-topAttachment attach_widget \
-topWidget $dirLabel \
-leftAttachment attach_form \
-bottomAttachment attach_position \
-bottomPosition 45
$dirsToolbar setValues \
-topAttachment attach_position \
-topPosition 50 \
-leftAttachment attach_form \
-bottomAttachment attach_form
$pane setValues \
-topAttachment attach_widget \
-topWidget $dirLabel \
-leftAttachment attach_widget \
-leftWidget $filesToolbar \
-rightAttachment attach_form \
-bottomAttachment attach_form
}
#######################################################################
#
# This section contains the callbacks for the various widgets
#
#######################################################################
#
# fileToolButtonPressed
#
proc fileToolButtonPressed {n} {
global fileToolbarButtonAction
global selectedFile
set oldAction [lindex $fileToolbarButtonAction($n) 3]
regsub -all {\$0} $oldAction $selectedFile newAction
if { [regexp {^\$} $newAction] } {
builtinCommand "$newAction"
} else {
set runInXterm [lindex $fileToolbarButtonAction($n) 0]
set pauseAfterExec [lindex $fileToolbarButtonAction($n) 1]
doCommand "$newAction" $runInXterm $pauseAfterExec
}
}
#
# fileButtonPressed
#
proc fileButtonPressed {widget type} {
global actions
global fileToolbarButtons
global fileToolbarButtonAction
global FILES_TOOLBAR_SIZE
global selectedFile
global selectedWidget
if {$selectedWidget != ""} {
invertColours $selectedWidget unhighlight
}
$widget getValues -labelString file
set selectedFile $file
set selectedWidget $widget
invertColours $selectedWidget highlight
foreach f $actions {
set t_def [lindex $f 0]
if {$t_def != $type} continue
set pattern [lindex $f 1]
if { ! [string match $pattern $file] } continue
# we have a match!
set pixmap [lindex $f 2]
set description [lindex $f 3]
set acts [lindex $f 4]
set m 0
set length [llength $acts]
while {$m < $length && $m < $FILES_TOOLBAR_SIZE} {
set a [lindex $acts $m]
$fileToolbarButtons($m) setValues \
-labelString [lindex $a 2]
$fileToolbarButtons($m) setSensitive true
set fileToolbarButtonAction($m) $a
incr m
}
# clear other buttons
while {$m < $FILES_TOOLBAR_SIZE} {
$fileToolbarButtons($m) setSensitive false
$fileToolbarButtons($m) setValues \
-labelString ""
incr m
}
break
}
}
#
# fileButtonReleased
#
proc fileButtonReleased {widget type} {
$widget getValues -labelString file
}
#
# fileButtonExposed
#
proc fileButtonExposed {widget type} {
global buttonsInfo
$widget getValues -labelString file
set fileInfo $buttonsInfo($widget)
set filename [lindex $fileInfo 0]
set gc [lindex $fileInfo 3]
$widget getValues -height h
$widget drawImageString $gc 0 [expr $h-5] $filename
}
#######################################################################
#
# This section handles commands when they are selected
#
#######################################################################
#
# builtinCommand
#
proc builtinCommand {command} {
if { [regexp {^\$cd} $command] } {
set dirName [lindex $command 1]
cd $dirName
panelSetFiles .main.form.pane
}
}
#
# doCommand
# - this handles the non builtin commands
#
proc doCommand {command runInXterm pauseAfterExec} {
if {$runInXterm && $pauseAfterExec} {
set newCommand "xterm -e pauseme $command"
} else {
if {$runInXterm} {
set newCommand "xterm -e $command"
} else {
set newCommand $command
}
}
eval exec $newCommand < /dev/null &
}
#######################################################################
#
# this section handles the dynamic updating of files displayed in the
# various pane areas
#
#######################################################################
#
# pixmapOf
# - find the pixmap for a filename
#
proc pixmapOf {file type} {
global actions
foreach f $actions {
set t_def [lindex $f 0]
if {$t_def != $type} continue
set pattern [lindex $f 1]
if { ! [string match $pattern $file] } continue
# we have a match!
set pixmap [lindex $f 2]
return $pixmap
}
}
#
# setGCs
#
proc setGCs {widget} {
global gc gc_reversed
$widget getValues -foreground fg -background bg
set gc [$widget getGC -foreground $fg -background $bg]
set gc_reversed [$widget getGC -foreground $bg -background $fg]
}
#
# newPaneButton
#
proc newPaneButton {parent n} {
xmDrawnButton $parent.button$n managed \
-labelType pixmap
return $parent.button$n
}
#
# panelSetFiles
# - the toplevel setter
#
proc panelSetFiles {panel} {
global dirArray
global fileArray
global executableArray
global buttonsInfo
global gc
global gc_reversed
global firstTime
set dirCount 0
set fileCount 0
set executableCount 0
setGCs $panel
# turn off unpleasant screen draws
if { $firstTime != 0 } {
$panel.rc1.sw.executablesPane unmapWidget
$panel.rc2.sw.filesPane unmapWidget
$panel.rc3.sw.dirsPane unmapWidget
}
set files [exec ls -a]
foreach f $files {
if { [file isdirectory $f] } {
if { ! [info exists dirArray($dirCount)] } {
set button \
[newPaneButton $panel.rc3.sw.dirsPane $dirCount]
$button armCallback {fileButtonPressed %w d}
$button activateCallback {fileButtonReleased %w d}
$button exposeCallback {fileButtonExposed %w d}
set dirArray($dirCount) $button
}
set pixmap [pixmapOf $f d]
$dirArray($dirCount) setValues \
-labelPixmap $pixmap \
-labelString $f
$dirArray($dirCount) manageChild
set buttonsInfo($dirArray($dirCount)) \
[list $f d $pixmap $gc $gc_reversed]
incr dirCount
continue
}
if { [file executable $f] } {
if { ! [info exists executableArray($executableCount)] } {
set button \
[newPaneButton $panel.rc1.sw.executablesPane $executableCount]
$button activateCallback {fileButtonReleased %w x}
$button armCallback {fileButtonPressed %w x}
$button exposeCallback {fileButtonExposed %w x}
set executableArray($executableCount) $button
}
set pixmap [pixmapOf $f x]
$executableArray($executableCount) setValues \
-labelPixmap $pixmap \
-labelString $f
$executableArray($executableCount) manageChild
set buttonsInfo($executableArray($executableCount)) \
[list $f d $pixmap $gc $gc_reversed]
incr executableCount
continue
}
if { ! [info exists fileArray($fileCount)] } {
set button \
[newPaneButton $panel.rc2.sw.filesPane $fileCount]
$button armCallback {fileButtonPressed %w f}
$button exposeCallback {fileButtonExposed %w f}
$button activateCallback {fileButtonReleased %w f}
set fileArray($fileCount) $button
}
set pixmap [pixmapOf $f f]
$fileArray($fileCount) setValues \
-labelString $f \
-labelPixmap $pixmap
$fileArray($fileCount) manageChild
set buttonsInfo($fileArray($fileCount)) \
[list $f d $pixmap $gc $gc_reversed]
incr fileCount
}
# now we get to unmanage all the files that are still showing
while { [info exists dirArray($dirCount)]} {
$dirArray($dirCount) unmanageChild
incr dirCount
}
while { [info exists executableArray($executableCount)]} {
$executableArray($executableCount) unmanageChild
incr executableCount
}
while { [info exists fileArray($fileCount)]} {
$fileArray($fileCount) unmanageChild
incr fileCount
}
# make this all visible again
if { $firstTime != 0 } {
$panel.rc1.sw.executablesPane mapWidget
$panel.rc2.sw.filesPane mapWidget
$panel.rc3.sw.dirsPane mapWidget
}
set firstTime 1
}
#######################################################################
#
# this section covers what happens when a file is selected in a pane
#
#######################################################################
#
# invertColours
#
proc invertColours {widget highlight} {
global buttonsInfo
set fileInfo $buttonsInfo($widget)
set filename [lindex $fileInfo 0]
set pixmap [lindex $fileInfo 2]
set gc [lindex $fileInfo 3]
set gc_reversed [lindex $fileInfo 4]
set buttonsInfo($widget) \
[lreplace $fileInfo 3 4 $gc_reversed $gc]
# this is a roundabout route for inverting the
# pixmap, because I cannot set the fg and bg
# directly for it. may need to unmap to stop
# unpleasant visual effects
$widget getValues -foreground fg -background bg
if {"$highlight" == "highlight"} {
$widget unmapWidget
$widget setValues -foreground $bg -background $fg
$widget setValues -labelPixmap $pixmap
$widget setValues -foreground $fg -background $bg
$widget mapWidget
} else {
$widget setValues -labelPixmap $pixmap
}
# in xmfm this was XClearArea:
$widget getValues -height h
$widget drawImageString $gc_reversed 0 [expr $h-5] $filename
}
#######################################################################
#
# this section handles parsing of the action specification file
#
#######################################################################
#
# loadActionsFile
#
proc loadActionsFile {} {
global env
if { [file exists xtmfmrc] } {
source xtmfmrc
return
}
set homeXtmfmrc $env(HOME)/.xtmfmrc
if { [file exists $homeXtmfmrc] } {
source $homeXtmfmrc
return
}
if { [info exists env(XAPPRESDIR)] } {
source $env(XAPPRESDIR)/xtmfmrc
return
}
if { [file exists "/usr/lib/X11/app-defaults/xtmfmrc"] } {
source "/usr/lib/X11/app-defaults/xtmfmrc"
return
}
puts stderr "Can't find xtmfmrc file"
exit 1
}
#
# load_actions
# - parse the actions list and store it
#
proc loadActions {inActs} {
global actions
set actions {}
foreach filetype $inActs {
set next [addFileType $filetype]
set actions [lappend actions $next]
}
}
#
# fileAction
# - parse the set of actions for an individual file type
#
proc fileAction {action} {
set act(label) ""
set act(run_in_xterm) 0
set act(pause_after_exec) 0
set act(action) ""
set act(prompt) ""
set act(confirm) ""
set n 0
set length [llength $action]
while {$n < $length} {
set item [lindex $action $n]
case $item in {
run_in_xterm {set act(run_in_xterm) 1}
pause_after_exec {set act(pause_after_exec) 1}
label {
incr n
set act(label) [lindex $action $n]
}
action {
incr n
set act(action) [lindex $action $n]
}
prompt {
incr n
set act(prompt) [lindex $action $n]
}
confirm {
incr n
set act(confirm) [lindex $action $n]
}
default {
puts stderr "unknown action $item"
}
}
incr n
}
return [list $act(run_in_xterm) $act(pause_after_exec) \
$act(label) $act(action) $act(prompt) $act(confirm)]
}
#
# parse the entry for a new filetype
#
proc addFileType {filetype} {
set n 0
set length [llength $filetype]
set a(type) ""
set a(pattern) ""
set a(pixmap) ""
set a(description) ""
set a(actions) {}
while {$n < $length} {
set current [lindex $filetype $n]
case $current in {
type {incr n
set a(type) [lindex $filetype $n]
incr n
}
pattern {incr n
set a(pattern) [lindex $filetype $n]
incr n
}
pixmap {incr n
set a(pixmap) [lindex $filetype $n]
incr n
}
description {incr n
set a(description) [lindex $filetype $n]
incr n
}
default {
set a(actions) [lappend a(actions) [fileAction $current]]
incr n 1
}
}
}
return [list $a(type) $a(pattern) $a(pixmap) $a(description) $a(actions)]
}
#######################################################################
#
# global commands to set this all going
#
#######################################################################
loadActionsFile
set selectedWidget ""
set firstTime 0
xtAppInitialize -class Xtmfm \
-fallbackResources {
{*main.width: 600}
{*main.height: 600}
{*filesToolbar*XmPushButton.height: 70}
{*filesToolbar*XmPushButton.width: 70}
{*filesToolbar*XmPushButton.recomputeSize: false}
{*filesToolbar.entryAlignment: alignment_center}
{*dirsToolbar*XmPushButton.height: 70}
{*dirsToolbar*XmPushButton.width: 70}
{*dirsToolbar*XmPushButton.recomputeSize: false}
{*dirsToolbar.entryAlignment: alignment_center}
{*XmDrawnButton.width: 100}
{*XmDrawnButton.height: 70}
{*XmDrawnButton.recomputeSize: false}
{*XmDrawnButton.shadowThickness: 0}
{*XmDrawnButton.borderWidth: 0}
{*XmDrawnButton.highlightThickness: 0}
{*executablesPane.packing: pack_column}
{*executablesPane.orientation: vertical}
{*executablesPane.numColumns: 4}
{*dirsPane.packing: pack_column}
{*dirsPane.orientation: vertical}
{*dirsPane.numColumns: 4}
{*filesPane.packing: pack_column}
{*filesPane.orientation: vertical}
{*filesPane.numColumns: 4}
{*executableFilter.labelString: Filter *}
{*fileFilter.labelString: Filter *}
{*dirFilter.labelString: Filter *}
}
createApplication
. realizeWidget
. mainLoop